home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / wc_MessageB.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  11.3 KB  |  275 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         wc_MessageB.c
  5. * RCS:          $Header: wc_MessageB.c,v 1.3 91/03/14 03:14:53 mayer Exp $
  6. * Description:  XM_MESSAGE_BOX_WIDGET_CLASS
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Sat Oct 28 03:40:20 1989
  9. * Modified:     Thu Oct  3 23:55:57 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: wc_MessageB.c,v 1.3 91/03/14 03:14:53 mayer Exp $";
  43.  
  44. #include <stdio.h>
  45. #include <Xm/Xm.h>
  46. #include <Xm/MessageB.h>
  47. #include "winterp.h"
  48. #include "user_prefs.h"
  49. #include "xlisp/xlisp.h"
  50. #include "w_funtab.h"
  51.  
  52. static LVAL k_message_dialog;
  53. static LVAL k_error_dialog;
  54. static LVAL k_information_dialog;
  55. static LVAL k_question_dialog;
  56. static LVAL k_warning_dialog;
  57. static LVAL k_working_dialog;
  58.  
  59.  
  60. extern Widget Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(); /* w_classes.c */
  61.  
  62.  
  63. /*****************************************************************************
  64.  * (send XM_MESSAGE_BOX_WIDGET_CLASS :new 
  65.  *                           [:managed/:unmanaged]
  66.  *                           [:message_dialog/:error_dialog/
  67.  *                            :information_dialog,:question_dialog,
  68.  *                            :warning_dialog,:working_dialog]
  69.  *                           [<name>]
  70.  *                           <parent> 
  71.  *                           [:XMN_<arg1> <val1>]
  72.  *                           [. . .             ]
  73.  *                           [:XMN_<argN> <valN>])
  74.  *
  75.  * The optional keyword submessage :managed will cause a subsequent call
  76.  * to XtManageChild(). If the submessage :unmanaged is present, or no
  77.  * submessage, then XtManageChild() won't be called, and the resulting
  78.  * widget will be returned unmanaged.
  79.  *
  80.  *    (send XM_MESSAGE_BOX_WIDGET_CLASS :new ...)
  81.  *    --> XmCreateMessageBox();
  82.  *    (send XM_MESSAGE_BOX_WIDGET_CLASS :new :message_dialog ...)
  83.  *    --> XmCreateMessageDialog();
  84.  *    (send XM_MESSAGE_BOX_WIDGET_CLASS :new :error_dialog ...)
  85.  *    --> XmCreateErrorDialog();
  86.  *     (send XM_MESSAGE_BOX_WIDGET_CLASS :new :information_dialog ...)
  87.  *     --> XmCreateInformationDialog();
  88.  *     (send XM_MESSAGE_BOX_WIDGET_CLASS :new :question_dialog ...)
  89.  *     --> XmCreateQuestionDialog();
  90.  *     (send XM_MESSAGE_BOX_WIDGET_CLASS :new :warning_dialog ...)
  91.  *     --> XmCreateWarningDialog();
  92.  *     (send XM_MESSAGE_BOX_WIDGET_CLASS :new :working_dialog ...)
  93.  *     --> XmCreateWorkingDialog();
  94.  ****************************************************************************/
  95. LVAL Xm_Message_Box_Widget_Class_Method_ISNEW()
  96. {
  97.   extern ArgList Wres_Get_LispArglist(); /* from w_resources.c */
  98.   extern void    Wres_Free_C_Arglist_Data(); /* from w_resources.c */
  99.   extern LVAL k_managed, k_unmanaged;
  100.   LVAL self, o_parent;
  101.   char* name;
  102.   Boolean managed_p;
  103.   LVAL dialog_kind;
  104.   Widget widget_id, parent_widget_id;
  105.  
  106.   self = xlgaobject();        /* NOTE: xlobj.c:clnew() returns an OBJECT; if this method
  107.                    returns successfully, it will return a WIDGETOBJ */
  108.   
  109.   /* get optional managed/unmanaged arg */
  110.   if (moreargs() && ((*xlargv == k_managed) || (*xlargv == k_unmanaged)))
  111.     managed_p = (nextarg() == k_managed);
  112.   else
  113.     managed_p = FALSE;        /* by default don't call XtManageChild() */
  114.  
  115.   /* get optional :message_dialog/:error_dialog/... arg */
  116.   if (moreargs() && ((*xlargv == k_message_dialog)     ||
  117.              (*xlargv == k_error_dialog)       ||
  118.              (*xlargv == k_information_dialog) ||
  119.              (*xlargv == k_question_dialog)    ||
  120.              (*xlargv == k_warning_dialog)     ||
  121.              (*xlargv == k_working_dialog)))
  122.     dialog_kind = nextarg();
  123.   else
  124.     dialog_kind = NIL;        /* default is XmCreateMessageBox() */
  125.  
  126.   /* get optional <name> arg */
  127.   if (moreargs() && (stringp(*xlargv)))
  128.     name = (char*) getstring(nextarg());
  129.   else
  130.     name = "";            /* default name */
  131.  
  132.   /* get required <parent> widget-object arg */
  133.   parent_widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&o_parent);
  134.  
  135.   /*
  136.    * Store the widget object <self> in the XmNuserData resource on the
  137.    * widget. This will allow us to retrieve the widget object from Xtoolkit
  138.    * functions returning widget ID's without having to keep around a table
  139.    * of widgetID-->widget-objects.
  140.    */
  141.    ARGLIST_RESET(); ARGLIST_ADD(XmNuserData, (XtArgVal) self); 
  142.  
  143.   if (moreargs()) {        /* if there are more arguments, */
  144.     Cardinal xt_numargs;    /* then we have some extra widget resources to set */
  145.     ArgList xt_arglist = Wres_Get_LispArglist(self, parent_widget_id, ARGLIST(), &xt_numargs);
  146.     if (dialog_kind == NIL)
  147.       widget_id = XmCreateMessageBox(parent_widget_id, name, xt_arglist, xt_numargs);
  148.     else if (dialog_kind == k_message_dialog)
  149.       widget_id = XmCreateMessageDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  150.     else if (dialog_kind == k_error_dialog)
  151.       widget_id = XmCreateErrorDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  152.     else if (dialog_kind == k_information_dialog)
  153.       widget_id = XmCreateInformationDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  154.     else if (dialog_kind == k_question_dialog)
  155.       widget_id = XmCreateQuestionDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  156.     else if (dialog_kind == k_warning_dialog)
  157.       widget_id = XmCreateWarningDialog(parent_widget_id, name,    xt_arglist, xt_numargs);
  158.     else if (dialog_kind == k_working_dialog)
  159.       widget_id = XmCreateWorkingDialog(parent_widget_id, name, xt_arglist, xt_numargs);
  160.     else
  161.       xlfatal("Bug in Xm_Message_Box_Widget_Class_Method_ISNEW()");
  162.     Wres_Free_C_Arglist_Data();
  163.   }
  164.   else 
  165.     if (dialog_kind == NIL)
  166.       widget_id = XmCreateMessageBox(parent_widget_id, name, ARGLIST());
  167.     else if (dialog_kind == k_message_dialog)
  168.       widget_id = XmCreateMessageDialog(parent_widget_id, name, ARGLIST());
  169.     else if (dialog_kind == k_error_dialog)
  170.       widget_id = XmCreateErrorDialog(parent_widget_id, name, ARGLIST());
  171.     else if (dialog_kind == k_information_dialog)
  172.       widget_id = XmCreateInformationDialog(parent_widget_id, name, ARGLIST());
  173.     else if (dialog_kind == k_question_dialog)
  174.       widget_id = XmCreateQuestionDialog(parent_widget_id, name, ARGLIST());
  175.     else if (dialog_kind == k_warning_dialog)
  176.       widget_id = XmCreateWarningDialog(parent_widget_id, name, ARGLIST());       
  177.     else if (dialog_kind == k_working_dialog)
  178.       widget_id = XmCreateWorkingDialog(parent_widget_id, name, ARGLIST());
  179.     else
  180.       xlfatal("Bug in Xm_Message_Box_Widget_Class_Method_ISNEW()");
  181.  
  182.   Wcls_Initialize_WIDGETOBJ(self, widget_id);
  183.  
  184.   if (managed_p)
  185.     XtManageChild(widget_id);
  186.   
  187. #ifdef DEBUG_WINTERP_1
  188.   Wcls_Print_WidgetObj_Info(self);
  189. #endif
  190.   return (self);
  191. }
  192.  
  193.  
  194. /*****************************************************************************
  195.  * (send <messageboxwidget> :GET_CHILD <symbol>)
  196.  * This method returns  a WIDGETOBJ, the child of <messageboxwidget> 
  197.  * corresponding to <symbol>:
  198.  * :DIALOG_DEFAULT_BUTTON
  199.  * :DIALOG_SYMBOL_LABEL
  200.  * :DIALOG_MESSAGE_LABEL
  201.  * :DIALOG_OK_BUTTON
  202.  * :DIALOG_CANCEL_BUTTON
  203.  * :DIALOG_HELP_BUTTON
  204.  * :DIALOG_SEPARATOR
  205.  *
  206.  * Widget XmMessageBoxGetChild (widget, child)
  207.  * Widget          widget;
  208.  * unsigned char   child;
  209.  ****************************************************************************/
  210. LVAL Xm_Message_Box_Widget_Class_Method_GET_CHILD()
  211. {
  212.   extern LVAL Wcls_WidgetID_To_WIDGETOBJ();
  213.   extern LVAL s_XmDIALOG_DEFAULT_BUTTON, s_XmDIALOG_SYMBOL_LABEL,
  214.   s_XmDIALOG_MESSAGE_LABEL, s_XmDIALOG_OK_BUTTON, s_XmDIALOG_CANCEL_BUTTON,
  215.   s_XmDIALOG_HELP_BUTTON, s_XmDIALOG_SEPARATOR;
  216.   LVAL self, lval_child;
  217.   Widget widget_id;
  218.   unsigned char child;
  219.   
  220.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  221.   lval_child = xlgasymbol();
  222.   xllastarg();
  223.   
  224.   if (lval_child == s_XmDIALOG_DEFAULT_BUTTON)
  225.     child = XmDIALOG_DEFAULT_BUTTON;
  226.   else if (lval_child == s_XmDIALOG_SYMBOL_LABEL)
  227.     child = XmDIALOG_SYMBOL_LABEL;
  228.   else if (lval_child == s_XmDIALOG_MESSAGE_LABEL)
  229.     child = XmDIALOG_MESSAGE_LABEL;
  230.   else if (lval_child == s_XmDIALOG_OK_BUTTON)
  231.     child = XmDIALOG_OK_BUTTON;
  232.   else if (lval_child == s_XmDIALOG_CANCEL_BUTTON)
  233.     child = XmDIALOG_CANCEL_BUTTON;
  234.   else if (lval_child == s_XmDIALOG_HELP_BUTTON)
  235.     child = XmDIALOG_HELP_BUTTON;
  236.   else if (lval_child == s_XmDIALOG_SEPARATOR)
  237.     child = XmDIALOG_SEPARATOR;
  238.   else 
  239.     xlerror("MESSAGE_BOX_WIDGET_CLASS method :GET_CHILD -- unknown child type.", lval_child);
  240.  
  241.   return (Wcls_WidgetID_To_WIDGETOBJ(XmMessageBoxGetChild(widget_id, child)));  
  242. }
  243.  
  244. /******************************************************************************
  245.  *
  246.  ******************************************************************************/
  247. Wc_MessageB_Init()
  248. {
  249.   LVAL o_XM_MESSAGE_BOX_WIDGET_CLASS;
  250.   extern LVAL Wcls_Create_Subclass_Of_WIDGET_CLASS(); /* w_classes.c */
  251.   extern      xladdmsg();    /* from xlobj.c */
  252.  
  253.   k_message_dialog     = xlenter(":MESSAGE_DIALOG");
  254.   k_error_dialog       = xlenter(":ERROR_DIALOG");
  255.   k_information_dialog = xlenter(":INFORMATION_DIALOG");
  256.   k_question_dialog    = xlenter(":QUESTION_DIALOG");
  257.   k_warning_dialog     = xlenter(":WARNING_DIALOG");
  258.   k_working_dialog     = xlenter(":WORKING_DIALOG");
  259.  
  260.   o_XM_MESSAGE_BOX_WIDGET_CLASS =
  261.     Wcls_Create_Subclass_Of_WIDGET_CLASS("XM_MESSAGE_BOX_WIDGET_CLASS",
  262.                      xmMessageBoxWidgetClass);
  263.   
  264.   /* a special :isnew method on this class allows for the creation of this
  265.      widget inside a popup shell if one of the following submessage keywords
  266.      are given: 
  267.      :message_dialog, :error_dialog, :information_dialog, 
  268.      :question_dialog, :warning_dialog, :working_dialog */
  269.   xladdmsg(o_XM_MESSAGE_BOX_WIDGET_CLASS, ":ISNEW", 
  270.        FTAB_Xm_Message_Box_Widget_Class_Method_ISNEW);
  271.  
  272.   xladdmsg(o_XM_MESSAGE_BOX_WIDGET_CLASS, ":GET_CHILD", 
  273.        FTAB_Xm_Message_Box_Widget_Class_Method_GET_CHILD);
  274. }
  275.